;; Copyright 2010 Peter Goncharov

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or	
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

(in-package :cl-money-type)

(defmacro def-op-m-m (name op)
  `(defmethod ,name ((val-a money) (val-b money))
     (let ((p-a (money-prec val-a))
	   (p-b (money-prec val-b)))
       (cond
	 ((<= p-a p-b) (,op (round-to-prec val-a p-b) (round-to-prec  val-b)))
	 ((< p-b p-a) (,op (round-to-prec val-a) (round-to-prec val-b p-a)))))))

(defmacro def-op-m-r (name op)
  `(progn
     (defmethod ,name ((val-a money) (val-b rational))
       (,op (money-amount val-a) (round-to-prec val-b (money-prec val-a))))
     (defmethod ,name ((val-a rational) (val-b money))
       (,op (round-to-prec val-a (money-prec val-b)) (money-amount val-b)))))

(defmacro def-op-r-r (name op)
  `(defmethod ,name ((val-a rational) (val-b rational))
     (,op val-a val-b)))

(defmacro def-operations (name op)
  `(progn
     (def-op-m-m ,name ,op)
     (def-op-m-r ,name ,op)
     (def-op-r-r ,name ,op)))

(defmacro def-ar-op-r-r (name op)
  `(defmethod ,name ((val-a rational) (val-b rational))
     (make-money :amount (,op val-a val-b))))

(defmacro def-ar-op-m-m (name op)
  `(defmethod ,name ((val-a money) (val-b money))
     (let ((prec (max (money-prec val-a) (money-prec val-b))))
       (make-money :amount (,op (money-amount val-a) (money-amount val-b))
		   :prec prec))))

(defmacro def-ar-op-m-r (name op)
  `(progn
     (defmethod ,name ((val-a money) (val-b rational))
       (make-money :amount (,op (money-amount val-a) val-b)
		   :prec (money-prec val-a)))
     (defmethod ,name ((val-a rational) (val-b money))
       (make-money :amount (,op val-a (money-amount val-b))
		   :prec (money-prec val-b)))))

(defmacro def-ar-operations (name op)
  `(progn
     (def-ar-op-r-r ,name ,op)
     (def-ar-op-m-m ,name ,op)
     (def-ar-op-m-r ,name ,op)))

(defun round-to-ratio (number precision &optional (round-function #'round))
  "Reduces the NUMBER up to a PRECISION number of decimal places, return a ration.
Round-function is one of
  #'floor
  #'ceil
  #'truncate
  #'round (is default)."
  (let ((div (expt 10 precision)))
    (/ (funcall round-function (* number div)) div)))
